UNIVERSAL HDRFIL
↓ALWAYS←←0
EXTERNAL  JOBSA,JOBVER,JOBREN,JOBUUO
EXTERNAL JOBSYM,JOBFF,JOBREL,JOB41,JOBDDT,JOBCNI,JOBTPC,JOBUUO
EXTERNAL JOBAPR,JOBHRL
SUBTTL	SAIL/GOGOL MACROS AND SWITCHES
DEFINE DEC <IFE STANSW!TENXSW!CMUSW!TYMSW,>	;HAS TOPS-10 FEATURES (ESP. MPB)
DEFINE NODEC <IFN STANSW!TENXSW!CMUSW,>	;SITE WITHOUT ALL TOPS-10 FEATURES
DEFINE STANFO <IFN STANSW,>	;code for stanford only
DEFINE NOSTANFO <IFE STANSW,>	;code not allowed at stanford ever
DEFINE EXPO <IFN EXPORT, >	;code for export only (BEING PHASED OUT)
DEFINE NOEXPO <IFE EXPORT, >	;code for Stanford only (BEING PHASED OUT)
DEFINE CMU <IFN CMUSW,>		;CODE ONLY FOR CMU
DEFINE NOCMU <IFE CMUSW,>	  ;CODE NEVER FOR CMU
DEFINE TYMSHR <IFN TYMSW,>
DEFINE NOTYMSHR <IFE TYMSW,>
DEFINE ITS <IFN ITSSW,>		;Code only for its
DEFINE NOITS <IFE ITSSW,>	;code never for its
DEFINE IMSSS <IFN IMSSSW,>	;IMSSS version of TENEX-SAIL
DEFINE NOIMSSS <IFE IMSSSW,>
DEFINE PARC <IFN PARCSW,>	;CODE ONLY FOR PARC
DEFINE NOPARC <IFE PARCSW,>	;NEVER FOR PARC
DEFINE SRIAI <IFN SRIAISW,>	;CODE ONLY FOR SRI-AI
DEFINE NOSRIAI <IFE SRIAISW,>	;NEVER 
DEFINE JPL <IFN JPLSW,>		;AT JPL
DEFINE NOJPL <IFE JPLSW,>	;NOT AT JPL
DEFINE SUMEX <IFN SUMEXSW,>	;AT SUMEX
DEFINE NOSUMEX <IFE SUMEXSW,>	;NOT AT SUMEX
DEFINE UOR <IFN UORSW,>		; CODE FOR UNIV OF ROCHESTER
DEFINE NOUOR <IFE UORSW,>	;NOT AT U OF R
DEFINE URHASH <IFN URHSW,>	;NEW LEAP HASH ROUTINES AND SEARCHES
DEFINE NOURHASH <IFE URHSW,>
DEFINE URLEAP <IFN URLPSW,>	;TRUE FOR DESCENDING ITEM ALLOCATION
DEFINE NOURLEAP <IFE URLPSW,>	;LOCALS ASCENDING, GLOBALS DESCENDING
DEFINE URSTAT<IFN URSTSW,>	;TRUE IF YOU WANT LEAP SEARCH STATISTICS
DEFINE NOURSTAT <IFE URSTSW,>	;NO STATISTICS PLEASE
DEFINE BAIL <IFN BAISW,>	;DEBUGGER STUFF
DEFINE NOBAIL <IFE BAISW,>
DEFINE GLOB <IFN GLOBSW, >	;since global compiler (GLOBC) can service
DEFINE NOGLOB <IFE GLOBSW, >	; non-global code, GLOBC is different
DEFINE GLOC <IFN GLOBC, >	; from GLOB (global model)
DEFINE NOGLOC <IFE GLOBC, >
DEFINE UP <IFN UPPER,>		;upper segment code (only used in runtime)
DEFINE NOUP <IFE UPPER,>	;not
DEFINE LOW <IFN LOWER,>		;lower bootstrap for 2 seg thing (ditto)
DEFINE NOLOW <IFE LOWER,>	;not
DEFINE LEP <IFN LEAPSW,>	;this compiler understands LEAP
DEFINE NOLEP <IFE LEAPSW,>	;doesn't (applies to runtime too)
DEFINE REN <IFN RENSW,>		;Re-entrant output (comp), runtimes (runtim)
DEFINE NOREN <IFE RENSW,>
DEFINE RENC <IFN RENCSW,>	;The compiler itself is reentrant
DEFINE NORENC <IFE RENCSW,>	;The compiler itself is not reentrant
DEFINE HACK <IFN HACKSW,>	;TEMPORARILY VERSION FOR STANFORD
DEFINE NOHACK<IFE HACKSW,>	; WILL DISAPPEAR NEXT SAISG
DEFINE TENX<IFN TENXSW,>	;FOR TENEX SYSTEMS
DEFINE NOTENX<IFE TENXSW,>	;NOT
DEFINE REC <IFN RCDSW,>		;RECORDS ARE CONDITIONAL UNTIL DEBUGGED BETTER
DEFINE NOREC <IFE RCDSW,>	;RECSW WAS A VARIABLE IN THE COMPILER
DEFINE RGC <IFN RGCSW,>		;RECORD GARBAGE COLLECTION (INSTEAD OF REF CNT)
DEFINE NORGC <IFE RGCSW,>	;NOT
DEFINE NRC <IFN NRCSW,>		;NEW-STYLE RECORD DESCRIPTORS
DEFINE NONRC <IFE NRCSW,>	;NOT
DEFINE KI10 <IFN KI10SW,>	;CPU IS A KI10
DEFINE NOKI10 <IFE KI10SW,>	;NOT
DEFINE XCOM <IFN XCOMSW,>	;COMPILER SAVE/RESTART (EXTEND) FACILITY
DEFINE NOXCOM <IFE XCOMSW,>
DEFINE SFDS <IFG SFDLVL,>
DEFINE NOSFDS <IFE SFDLVL,>	;NOT USED AT THE MOMENT
DEFINE STSW (V,VL) <IFNDEF V,<?V←←VL>>
IFDEF SPCWAR,<STSW(STANSW,1)> ;SPCWAR ONLY DEFINED AT STANFORD
STSW (STANSW,0);WE MUST BE EXPORTING
STSW (HACKSW,STANSW) ;ONLY AT STANFORD
STSW (TENXSW,0); NOT USUSALLY AT TENEX
STSW (CMUSW,0); NOT USUALLY AT CMU 
IFDEF AUXCAL,<STSW (TYMSW,1)>
STSW (TYMSW,0); IN CASE THE LINE ABOVE DOES NOT TAKE
STSW (ITSSW,0); NOT USUALLY AT MIT
STSW (IMSSSW,0); NOT USUALLY AT IMSSS
STSW (PARCSW,0); NOT USUALLY AT PARC
STSW (SRIAISW,0); NOT USUALLY AT SRIAI
STSW (JPLSW,0);	NOT USUALLY AT JPL
STSW (SUMEXSW,0); NOT USUALLY AT SUMEX
STSW (UORSW,0); NOT USUALLY AT UOR
STSW (RENCSW,0)	;NOT USUALLY A REENTRANT COMPILER
STSW (DECSW,1); USUALLY DEC 10-50 BASED SYSTEM
STSW (HEDSYM,0)		;USUALLY NOT A USER-TABLE SYMBOL GENERATOR
STSW (KI10SW,0)		;USUALLY NOT A KI10 PROCESSOR
STSW (XCOMSW,1)		;COMPILER SAVE/RESTART USUALLY SUPPORTED
STSW (SFDLVL,5)		;NORMAL SITE ALLOWS SFDs
NOCMU <
STSW(GLOBSW,0)		;USUALLY NOT A GLOBAL SEGMENT BEING MADE
>;NOCMU
NOSTANFO <
?EXPORT ←← 1 	; TAKE CARE OF OBSOLETE SWITCH
STSW (SIXSW,0)
>;NOSTANFO
STANFO <
?EXPORT ←← 0
STSW (SIXSW,1)
?SFDLVL←←0		;STANFORD DOESN'T HAVE SFD'S
>;STANFO	
STSW(RCDSW,1); 
STSW(RGCSW,RCDSW); DITTO, ALSO REALLY ONLY USE WHEN DEBUGGING COMPILER UNTIL BETTER
STSW(NRCSW,1); USUALLY A NEW-STYLE RECORD SYSTEM (now) ****
CMU < ;**** EXTRA SWITCHES FOR CMU ******
DEFINE GGAS <IFN GASSW,>	;cmu version of global segment
DEFINE NOGGAS <IFE GASSW,>	;inverse
DEFINE GGGON <↑↑ GLOBSW←←GASSW>	;
DEFINE GGGOFF <↑↑ GLOBSW ←←0>	;USED TO SELECT SOME OF SU-AI GLOB STUFF
STSW(GASSW,0)			;NOT USUALLY CMU GLOBAL
STSW(GLOBSW,0)			;CMU WILL DIDDLE THIS SWITCH DIRECTLY
?SFDLVL←←0		 ;CMU DOESN'T HAVE SFD'S
>;CMU
IMSSS <;DEFAULT SETTINGS AT IMSSS
?TENXSW←←1			;TENEX AT IMSSS
?SIXSW←←1			;USE SIXBIT PPN'S FOR LOADER AT IMSSS
>;IMSSS
PARC <
?TENXSW←←1			;TENEX AT PARC
?SIXSW←←0
>;PARC
JPL <
?TENXSW←←1
?SIXSW←←0
>;JPL
SRIAI <
?TENXSW←←1			
?SIXSW←←0
?RUBCHAR←←"A"-100		;CONTROL-A FOR CHARACTER DELETE
?DELLINE←←"X"-100		;CONTROL-X FOR LINE DELETE
>;SRIAI
SUMEX <
?IMSSSW←←1			;MOST IMSSS FEATURES
?SIXSW←←0			;EXCEPT DONT USE SIXBIT
?TENXSW←←1			;BUT IS TENEX
>;SUMEX
UOR <
?DECSW ←← 1			;DEC TOPS-10 MONITOR
?EXPORT ←← 1			; NOT AT STANFORD
?STANSW ←← 0			; NOT AT STANFORD
?GLOCSW ←← 0			; NO GLOBAL MODEL
?GLOBSW ←← 0			; NO GLOBAL MODEL STUFF
?URHSW ←← 1			; USE NEW HASH TECHNIQUE
?URLPSW ←← 1			; ALLOCATE ITEMS TOP DOWN
>;UOR
TENX <
?RENCSW←←1			;WANT A RE-ENTRANT COMPILER
?RENSW←←1			;WANT A RE-ENTRANT RUNTIME
?DECSW←←0			;NOT A DEC SYSTEM
?EXPORT←←1			;AVOID STANFORD FEATURES
?STANSW←←0			;IN FACT, EXPLICITLY NOT STANFORD
?GLOBSW←←0			;NOT USUALLY GLOBAL FOR TENEX
?GLOBC←←0			;
STSW(LOADVR,=54)			;TENEX SITES SEEM TO HAVE V. 54
?SFDLVL←←0			;NO TENEX SITE HAS SFD'S
>;TENX
TYMSHR<
?SFDLVL←←0			;NO SFD'S AT TYMSHARE
>;TYMSHR
STSW (BAISW,1)		;USUALLY ON
STSW (URHSW,0)		; LEAVE OFF UNLESS EXPLICITLY ASKED FOR
STSW (URLPSW,URHSW)		;MIGHT AS WELL USE BOTH AS ONE
STSW (URSTSW,0)			;GENERALLY DON'T WANT THIS
IFG	URLPSW-URHSW,<		;IF URLPSW = 1 & URHSW = 0
	PRINTX	URLPSW REQUIRES URHSW [FAIL ERROR ON NEXT LINE]
	#SWERR
>
IFNDEF TSTSEG,<TSTSEG←←0>
NOTENX <
IFN TSTSEG,<
DEFINE FILXXX <SIXBIT /SAISGT/>
DEFINE SLOFIL <SIXBIT /SAILWT/>
DEFINE SGDEVC <SIXBIT /DSK/>
STANFO <
DEFINE SGPPNN <SIXBIT /  SAIL/>
>;STANFO
NOSTAN <
DEFINE SGPPPN <0>
>;NOSTAN
?LOCSYM←←1
?NOPROT←←1
>
IFNDEF FILXXX,<DEFINE FILXXX <SIXBIT /SAISG8/>>
IFNDEF SLOFIL,<DEFINE SLOFIL <SIXBIT /SAILOW/>>;PRODUCTION SAIL
IFNDEF SGDEVC,<DEFINE SGDEVC <SIXBIT /SYS/>>
IFNDEF SGPPNN,<DEFINE SGPPNN <0>>
IFNDEF LOCSYM,<?LOCSYM←←0>;DON'T WANT LOCAL SEGMENT SYMBOLS
IFNDEF NOPROT,<?NOPROT←←0>	;DON'T WANT SEGMENT PROTECT IF NOT GLOBAL
DEFINE PROCSR <ASCIZ /SAIL: />	;FOR PRINTOUT OF PROCESSOR
DEFINE RPGFIL <SIXBIT /QQSAIL/> ;FOR COMPIL PURPOSES
DEFINE DEFEXT <'SAI'>		;DEFAULT EXTENSION
IFNDEF BKTFIL,<DEFINE BKTFIL <=9
			     POINT 7,[ASCIZ /BKTBL.BKT/],-1 >>
?LIBLEN←←=10				;LENGTH OF FOLLOWING STRINGS
DEFINE LIBLOW <ASCIZ /SYS:LIBSA8/>	;REQUIRED LIBRARIES
DEFINE LIBHI  <ASCIZ /SYS:HLBSA8/>	; (HISEG VERSION)
BAIL<
?BALENG←←=12				;LENGTH OF FOLLOWING STRING
DEFINE BAILOD <ASCIZ /SYS:BAIL.REL/>	;RESIDENCE OF BAIL
?BPDALN←←=14				; LENGTH OF FOLLOWING STRING
DEFINE BAIPDS <ASCIZ /SYS:BAIPD8.REL/>
>;BAIL
DEFINE OPDEV   <SIXBIT /SYS/>		;DEVICE FOR OPCODE FILE
DEFINE OPNAME  <SIXBIT /2OPS2/>		;NAME OF SAME (EXTEN ALWAYS OPS)
DEFINE OPPPN   <0>			;WHERE IT'S AT
GLOB <
DEFINE FILXXX <SIXBIT /GLBSG8/>
DEFINE SLOFIL <SIXBIT /GLBLOW/>
DEFINE SGDEVC,<SIXBIT /SYS/>
DEFINE SGPPNN,<0>
?NOPROT←←1
?LOCSYM←←1
>;GLOB
CMU <
GGAS <	;OH WELL
DEFINE SGDEVC <SIXBIT/DSK/>
DEFINE FILXXX <SIXBIT/CONSEG/>
DEFINE SGPPNN <XWD 1305,60410>	
>;GGAS
>;CMU
>;NOTENX
TENX <
IFN TSTSEG,<
IFNDEF FILXXX,<DEFINE FILXXX <ASCIZ /<SAIL>T-SAISGT.SAV/>>
IFNDEF SLOFIL,<DEFINE SLOFIL <SIXBIT /SAILWT/>>
?LOCSYM←←1
?NOPROT←←1
IFNDEF LIBLOW,<DEFINE LIBLOW <ASCIZ /LIBSAT.REL/>>
?LIBLEN←←=10
>;IFN TSTSEG
BAIL<
?BALENG←←=14				;LENGTH OF FOLLOWING STRING
DEFINE BAILOD <ASCIZ /<SAIL>BAIL.REL/>	;RESIDENCE OF BAIL
?BPDALN←←=16
DEFINE BAIPDS <ASCIZ /<SAIL>BAIPD8.REL/>
>;BAIL
IFE TSTSEG,<
IFNDEF FILXXX,<DEFINE FILXXX <ASCIZ /<SAIL>T-5-SAISG8.SAV/>>
IFNDEF SLOFIL,<DEFINE SLOFIL <SIXBIT /LOWTSA/>>
IFNDEF SLOLOD,<DEFINE SLOLOD <ASCIZ/SYS:LOWTSA,/>>	;FOR INTERFACE TO LOADER
?LOCSYM←←0
?NOPROT←←0
IFNDEF LIBLOW,<DEFINE LIBLOW <ASCIZ /<SAIL>LIBSA8.REL/>>
IFNDEF LIBHI,<DEFINE LIBHI <ASCIZ /<SAIL>HLBSA8.REL/>>
IMSSS<
IFNDEF SDTLOD,<DEFINE SDTLOD <ASCIZ/,SDDTRL[S,AIL]/>>
>;IMSSS
?LIBLEN←←=16
>;IFE TSTSEG
IFNDEF SEGPAG, <
?SEGPAG←←630				;PAGE WHERE THE SEGMENT STARTS
>;IFNDEF SEGPAG
IFNDEF STARTPAGE, <
?STARTPAGE←←610				;PAGE WHERE CHANNEL BUFFERS BEGIN
>;IFNDEF STARTPAGE
IFNDEF JFNSIZE, <
?JFNSIZE←←20				;NUMBER OF CHANNELS ALLOWED
>;IFNDEF JFNSIZE
IFNDEF RUNLOD,<DEFINE RUNLOD <=18
			      POINT 7,[ASCIZ/<SUBSYS>LOADER.SAV/],-1 >>
IFNDEF BKTFIL,<DEFINE BKTFIL <=15
			     POINT 7,[ASCIZ /<SAIL>BKTBL.BKT/],-1 >>
IFNDEF UDTFIL,<DEFINE UDTFIL <ASCIZ /<SAIL>UDDT.SAV/>>
IFNDEF OPFILE,<DEFINE OPFILE <ASCIZ /<SAIL>3OPS3.OPS/>>
>;TENX
STANFO <  ; ACTUALLY, NOT KEPT UP LATELY
>;STANFO
II←←1
FOR @' JJ IN (HEAD,SAIL,PARSE,PDEFS,PRODS,SUBRS,SMTB,SYM,GEN,ARRAY) <
?..'JJ←←II
II←←II⊗1
>
FOR @' JJ IN (EXPRS,STATS,LEAP,TOTAL,COMSER,GOGOL,STRSER,IOSER,LEPRUN,MESPRO,WRDGET) <
?..'JJ←←II
II←←II⊗1
>
IFDEF SETLST,<SETLST>
IFNDEF ..LIST,<
..LIST←←0
FOR @' JJ IN (HEAD,SAIL,PARSE,SYM,GEN,ARRAY,EXPRS,STATS,LEAP,TOTAL,COMSER) <
?..LIST←←..LIST!..'JJ
>
FOR @' JJ IN (GOGOL,STRSER,IOSER,LEPRUN,MESPRO,WRDGET) <
?..LIST←←..LIST!..'JJ
>>
IFDEF SETLS2,<
	SETLS2
>
DEFINE LSTON ' (JJ) <
	XLIST
IFN ..LIST & ..'JJ,<
	LIST>
>
	LSTON	(HEAD)
DEFINE DSCR <COMMENT ⊗ > ; FOR DIRECTORY MAKER
DEFINE GEN <IFE .NOGEN,<LALL>>
DEFINE NOGEN <XALL>
?.NOGEN←←1	;DON'T EXPAND MACROS AT ALL AFTER FIRST NOGEN
	NOGEN
DEFINE IFNB (X) <IFDIF <><X>,>
DEFINE IFB (X) <IFIDN <><X>,>
NOTENX <
?DSPLEN←←=260
>;NOTENX
TENX <
?DSPLEN←←=330	;LAST CHANGED 3-26-75, FROM 300
>;TENX
GLOB <
?DSPLEN←←DSPLEN+=50 ; SINCE THIS TAKES MORE
>;GLOB
DEFINE HERE(X) <
UP <
	FQQQQ ←← .
	USE DSPCH	;SO THAT THE LABELS HAVE THE SAME ADDRESS
↑↑ X :	JRST	FQQQQ
IFGE .-DSPBAS-DSPLEN, <
PRINTS / Dispatch vector size exceeded, bump DSPLEN
/
>;
	USE
>;UP
NOUP <
↑↑ X :			;IF NOT MAKING AN UPPER SEGMENT, DOES NOT MATTER.
>;NOUP
>
DEFINE HEREFK (X,XFAKE) <
UP<
↑↑ XFAKE:		; A FAKE LABEL (FELLOW WILL HAVE REAL THING IN SPARES
>;UP
NOUP <
HERE(X)			;ONLY MATTERS IF MAKING A SEGMENT
>;NOUP
>
DEFINE SETCOR (SIZE,FIRST,LAST) <
	MOVE	C,SIZE
	PUSHJ	P,CORGET
	ERR	<CAN'T GET CORE FOR FIRST ALLOCATION>
	IFDIF <FIRST><>, <MOVEM	B,FIRST>
	IFDIF <LAST><>,<
		ADD	C,B
		MOVEM	C,LAST
>>
DEFINE DATA (MSG) <
	USE	VBLS
	IFGE	.-DBASE-DSIZE,<
	PRINTX	DATA AREA TOO SMALL [you will get a FAIL error on next line]
	#DATERR
>>
DEFINE TABLEDATA (MSG) <
	ZERODATA ()
>
DEFINE TABCONDATA (MSG) <
	DATA ( )
>
DEFINE ZERODATA (MSG) <
	USE	ZVBLS
	IFGE	.-ZBASE-ZSIZE,<
	PRINTX	ZEROED DATA AREA TOO SMALL [you will get a FAIL error on next line]
	#DATERR
>>
DEFINE BITDATA (MSG) <	USE>
DEFINE BITDDATA (MSG) <	USE>
DEFINE BIT2DATA (MSG) <	USE>
DEFINE BITD2DATA (MSG) < USE>
DEFINE ACDATA (MSG) <	USE>
DEFINE AC2DATA (MSG) <	USE>
DEFINE ENDDATA <
IFDEF ZBASE, <
	DATA ()		;CHECK
	ZERODATA ()		;CHECK
	USE
>>
DEFINE LEVPOINT(AD)< POINT DLFLDL,AD,35-LLFLDL>
DEFINE TRPCAL (P1,P2,P3,P4,ADR) <
BEGIN
	SKIPN	ADR
	 JRST 	 NOTRP
CMU <  GGGON	;
>;CMU
GLOB <
	PUSH	P,USER
	MOVE	USER,GOGTAB	;IT MAY HAVE BEEN GLUSER
>;GLOB
	PUSH	P,TEMP
	PUSH	P,UUO1(USER)
	MOVEI	TEMP,.TRACS
	BLT	TEMP,.TRACS+11
	MOVE	TEMP,-1(P)
	PUSH	P,P1
	PUSH	P,P2
	PUSH	P,P3
	PUSH	P,P4
	PUSHJ	P,@ADR
	MOVSI	TEMP,.TRACS
	BLT	TEMP,11
	POP	P,UUO1(USER)
	POP	P,TEMP
GLOB <
	POP	P,USER		;GET IT BACK
>;GLOB
CMU <   GGGOFF			;DELSELECT GLOBAL STUFF
>;CMU
NOTRP:
BEND
>;END TRPCAL DEF
DEFINE MOVEWI (I,J) <
		MOVEI TEMP,J
		MOVEM TEMP,I
>
DEFINE MOVEW (I,J) <
		MOVE	TEMP,J
		MOVEM	TEMP,I
>
DEFINE MOVE6 (I,J) <
		MOVE	TEMP,[SIXBIT /J/]
		MOVEM	TEMP,I
>
DEFINE MOVEI7 (I,J) <
		MOVEI	TEMP,[ASCIZ /J/]
		MOVEM	TEMP,I
>
DEFINE LOAD6 (I,J) <
		MOVE	I,[SIXBIT /J/]
>
DEFINE LOADI7 (I,J) <
		MOVEI	I,[ASCIZ /J/]
>
DEFINE PWORD (A) <
	POINT	36,A,35>
DEFINE PLEFT (A) <
	POINT	18,A,17>
DEFINE PRIGHT (A) <
	POINT	18,A,35>
DEFINE PCHAR (A) <
	POINT	7,A,35>
DEFINE IPWORD (A) <
	POINT	36,A>
DEFINE IPLEFT (A) <
	POINT	18,A>
DEFINE IPRIGHT (A) <
	POINT	18,A,17>
DEFINE IPCHAR(A) <
	POINT	7,A>
DEFINE SAVACS (L) <
 FOR II IN  L ,<
	PUSH	P,II
>>
DEFINE RESTACS (L) <
FOR II  IN  L, <
	POP	P,II
>>
NOTENX <
NOSTANFO <
DEFINE CALL6 ' (I,J) <
	IFDIF <><J>,<
		IFDIF <><I>,<CALLI I,U'J;>  CALLI U'J
>
	IFIDN <><J>,<
		CALLI	U'I
>>
>;NOSTANFO
STANFO <
DEFINE CALL6 ' (I,J) <
	IFDIF <><J>,<
		IFDIF <><I>,<J I,;> J
>
	IFIDN <><J>,<
		I
>>
>;STANFO
NOSTANFO <
DEFINE CX ' (Y,Z) <
?U'Y←←Z
>
	CX RESET,0	;0 RESET IO
	CX DDTIN,1	;1 EXT-GET DDT CHAR.
	CX SETDDT,2	;2 SETDDT LOC IN PROTECTED JOB DATA
	CX DDTOUT,3	;3 EXT:SEND DDT CHAR.
	CX DEVCHR,4	;4 DEVICE CHARACTISTICS
	CX DDTGT,5	;5 GET DDT MODE
	CX GETCHR,6	;6 DEVICE CHAR.(DIFF. NAME)
	CX DDTRL,7	;7 RELEASE DDT MODE
	CX WAIT,10	;10 WAIT TILL DEVICE INACTIVE
	CX CORE,11	;11 CORE UUO
	CX EXIT,12	;12 EXIT
	CX UTPCLR,13	;13 CLEAR DEC TAPE DIRECTORY 
	CX DATE,14	;14 GET DATE
	CX APRENB,16	;16 ENABLE APR FOR TRAPPING
	CX SWITCH,17	;20 RETURN DATA SWITCHES
	CX REASSIGN,21	;21 REASSIGN DEVICE TO ANOTHER JOB
	CX TIMER,22	;22 RETURN JIFFY CLOCK TIME
	CX MSTIME,23	;23 RETURN TIME OF DAY IN MS
	CX GETPPN,24	;24 RETURN PROJECT-PROGRAMMER NUMBER
	CX TRPSET,25	;25 SET PI TRAP LOC, AND USER IO
	CX TRPJEN,26	;26 DISMISS INTERRUPT TO EXEC MODE
	CX RUNTIM,27	;27 RETURN TOTAL JOB RUNNING TIME
	CX PJOB,30	;30 RETURN JOB NUMBER
	CX SLEEP,31	;31 SLEEP FOR N SECONDS, THEN RETURN TO USER
	CX SETPOV,32	;32 SET PUSH DOWN OVERFLOW TRAP
	CX PEEK,33	;33 PEEK INTO SYSTEM CORE.		;JS
	CX GETLIN,34	;34 GET NAME OF TTY
	CX RUN,35	;35 RUN COMMAND
	CX SETUWP,36	;36 SET USER WRITE PROTECT
	CX REMAP,37	;37 REDO CORE MAP
	CX GETSEG,40	;40 GET SEGMENT
	CX GETTAB,41	;41 GETTAB ILLEGAL AT STANFORD.
>;NOSTANFO
>;NOTENX
DEFINE OP1 &(OPR,MS,ACC)  <
	IFIDN <ACC><>, <II←←0>
	IFDIF <ACC><>, <II←←ACC>
	OPR&. II,[ASCIZ /MS/]
>
FOR OP  IN  (ERR,IOERR) <
DEFINE OP (MSG,AC,ADDR) <
	IFIDN	<ADDR><>,<OP1 (OP,<MSG>,AC)>
	IFDIF <ADDR><>,<JRST	[OP1 (OP,<MSG>,AC)
			   JRST	ADDR ]>
>>
DEFINE CORERR(MSG) < JRST [	PUUO	3,[ASCIZ /MSG
/]
NOTENX <
				HALT	.	;DOT IN LITERALS REFERS TO THE
>;NOTENX
TENX <
				JSYS	HALTF
>;TENX
							]>
DEFINE ERRPRI (X) <
	PUSH	P,A
	MOVEI	A,[ASCIZ /X
/]
	PUSHJ	P,PRINT.
	POP	P,A
>
DEFINE PRINT (X) <
	PUUO 3,[ASCIZ /X/]
>
DEFINE TERPRI (X) <
	PUUO	3,[ASCIZ /X
/]>
DEFINE SPRINT(X) <	;SAFE PRINT, BEFORE UUO SET UP
	TTCALL 	3,[ASCIZ /X/]
>
DEFINE MAKCDB &  (CHN,NAM,MODD,I,O)  <
NAM&CDB:
NAM&MOD: MODD			;DATA MODE
NAM&DEV: 0			;DEVICE NAME IN SIXBIT
NAM&HED:
	IFN O,<XWD NAM&HDR,0;> NAM&HDR  ;BLOCK HEADER POINTER
NAM&HDR: 0			;I/O HEADER BLOCK
NAM&PNT: 0			;I/O BYTE POINTER
NAM&CNT: 0			;I/O CHAR COUNT
↑NAM&FIL: 0			;I/O FILE NAME
↑NAM&EXT: 0			;I/O EXTENSION
↑NAM&PPN: 0			;I/O PPN
NAM&OP:	OPEN	CHN,NAM&CDB	;OPEN INSTRUCTION
NAM&NT:
	IFN I,<LOOKUP CHN,NAME;> ENTER CHN,NAME
NAM&SPC:
	IFN O,<OUTBUF CHN,O>
IFE O,<
NOSTANFO <
	 IFIDN <NAM> <SRC>, <
		PUSHJ P,[MOVEI TEMP,.+1 ; PTR TO DESCRIPTOR, CALL UINBF ROUTINE
			 JRST	UINBF] ;>INBUF CHN,I
>;NOSTANFO
STANFO <
		    UINBF CHN,.+1
>;STANFO
>;IFE O
NAM&BFS: IFN O,<O;>	I		;# OF BUFFERS
	202	;MAKE BIGGER BUFFERS THAN NORMAL (INPUT ONLY)
SFDS<
NAM&PTH:	BLOCK 4+SFDLVL	;PLACE FOR PATH TO GO
> ;SFDS
>
DEFINE CHKCHN (AA,ROUTIN) & <
		TRZE	AA,777760	;ZERO BITS AND TEST VALID
		ERR <ROUTIN&: INVALID CHANNEL NUMBER>
>
DEFINE TSTERR (CHAN) <
		STATZ CHAN,740000 ;ANY ERRORS?
>
DEFINE TSTEOF (CHAN,EOFADD) <
		STATZ CHAN,20000  ;END OF FILE?
		JRST EOFADD	  ; YES
>
DEFINE SETNIT <
	MOVE	TEMP,[PUSHJ P,%UUOLNK]	;MAKE SURE WE CAN DO UUOS
	MOVEM	TEMP,41
	MOVE	P,ALLPDP	;AND PUSHJ'S
>
DEFINE SETPOV (AC,STR) <
 IFIDN <STR><><MOVEI TEMP,0;>MOVEI TEMP,[ASCIZ ?STR?] ;GET VALUE
 II←←(AC+17)&17			;BETWEEN 0 AND 17
 JJ←←II-(2*(II/2))		;ODD OR EVEN
 IFE JJ,<HRLM TEMP,POVTAB+(II/2); EVEN-- LEFT> HRRM TEMP,POVTAB+(II/2)
>;SETPOV
DEFINE OPTSYM(SYM)<
	MOVE	TEMP,[RADIX50 50,SYM]
	PUSHJ	P,OPTSY.
>
DEFINE BIT(NAME,BITT) <IFDIF <NAME><SPARE>,<?NAME←←BITT>>
DEFINE DEFTBS <
	BIT	(RES,400000)	;RESERVED WORD
	BIT	(CNST,200000)	;CONSTANT ENTRY
	BIT	(SPARE,100000)	;****
	BIT	(INTRNL,40000)	;INTERNAL SYMBOL (SYMBOL EXPORTED)
	BIT	(EXTRNL,20000)	;EXTERNAL SYMBOL (STORAGE FOUND ELSEWHERE)
	BIT	(MPBIND,10000)	;MATCHING PROCEDURE OR BINDING ITEMVAR
	BIT	(VALUE,4000)	;FORMAL PARAMETER CALL BY VALUE
	BIT	(REFRNC,2000)	;FORMAL PARAMETER CALL BY REFERENCE
	BIT	(CONOK,1000)	;OK TO CALL INTRINSIC WITH CONST ARGS AT COMPTIME
	BIT	(SIMPLE,400)	;FOR DISPLAY SYSTEMS ONLY
	BIT	(MESSAGE,200)	;A MESSAGE PROCEDURE !!!!!(STANFORD ONLY).
	BIT	(OWN,100)	;OWN VARIABLE ?
	BIT	(ANYTYP,40)	;ANYTYPED VARIABLE (USED IN PROCEDURE CALLS)
	BIT	(SAFE,20)	;SAFE -- FOR ARRAYS AND SUCH.
	BIT	(DEFINE,10)	;DEFINED MACRO IDENTIFIER
	BIT	(RECURS,4)	;THIS ROUTINE IS REENTRANT
	BIT	(BILTIN,2)	;IF ON IN TBITS, DON'T SAVE AC'S ON CALL.
	BIT	(SBSCRP,1)	;SUBSCRIPED VARIABLE (ARRAY)
	BIT	(INPROG,400000)	;PROCEDURE BEING DEFINED, KEEP FIXUP CHAIN
	BIT	(GLOBL,200000)	;GLOBAL LEAP VARIABLE
	BIT	(FORTRAN,100000);FORTRAN PROCEDURE (EXTERNAL)
	BIT	(FORWRD,40000)	;FORWARD PROCEDURE OR LABEL
	BIT	(PROCED,20000)	;PROCEDURE
	BIT	(SHORT,10000)	;SHORT INTEGER OR SHORT REAL
	BIT	(ITMVAR,4000)	;LEAP ITEMVAR
	BIT	(PNTVAR,2000)	;RECORD POINTER VARIABLE
	BIT	(BOOLEAN,1000)	;BOOLEAN VARIABLE ?? (SAME AS INTEGER FOR NOW
	BIT	(ITEM,400)	;LEAP ITEM
	BIT	(STRING,200)	;A FHQ STRING
	BIT	(LPARRAY,100)	;TYPE OF THIS ITEM IS ARRAY
	BIT	(SET,40)	;LEAP SET
	BIT	(LABEL,20)	;LABEL
	BIT	(LSTBIT,10)	; COMPLEX NUMBER ?? (NOT IMPLEMENTED)
	BIT	(DBLPRC,4)	; DOUBLE PRECISION NUMBER ?? (NOT IMPLEMENTED)
	BIT	(FLOTNG,2)	;REAL NUMBER
	BIT	(INTEGR,1)	;INTEGER NUMBER
	BIT	(KEEP,1)	;DO NOT FLUSH TYPE AHEAD
	BIT	(QUIET,2)	;DO NOT PRINT MESSAGES
	BIT	(NUMBS,4)	;DO PRINT THE "CALLED FROM .." STUFF
	BIT	(LOGGIN,10)	;SEND MESSAGES TO LOG FILE
	BIT	(CONT,20)	;CONTINUABLE ERROR
	BIT	(AUTO,40)	;AUTOMATIC CONTINUATION MODE
	BIT	(LOGOPN,100)	;LOG FILE IS CURRENTLY OPEN
	BIT	(ERRNOW,200)	;WE ARE CURRENTLY IN THE MIDDLE OF AN ERR. UUO
	BIT	(MINUS,400)	;WE JUST SAW A MINUS!
	BIT	(MADEPT,1000)	;WE HAVE ALREADY MADE A BYTE POINTER FOR FAKETTY
	BIT	(BUFOPN,2000)	;HE HAVE A BUFFER FOR DUMP MODE LOGGING
>
DEFTBS		;DEFINE THE TBITS
?FNYNAM ←← RECURS 		;EXTERNAL+OWN+FNYNAM MEANS EXT REQ IS FOR
NOKI10 <
FLOAT←2B8	OPDEF	FLOAT	[2B8]
STANFO <
PDPFIX←<KAFIX>	OPDEF	PDPFIX	[KAFIX]
>;STANFO
FIX←3B8		OPDEF	FIX	[3B8]
>;NOKI10
KI10 <
FLOAT←127000000000
		OPDEF	FLOAT	[127000000000]
FIX←126000000000
		OPDEF	FIX	[126000000000]
>;KI10
FIXR←126B8	OPDEF	FIXR	[126B8]
FLTR←127B8	OPDEF	FLTR	[127B8]
KIFIX←122B8	OPDEF	KIFIX	[122B8]
ADJSP←105B8	OPDEF	ADJSP	[105B8]
IOERR.←4B8	OPDEF	IOERR.	[4B8]
ERR.←5B8	OPDEF	ERR.	[5B8]
SIXPNT←6B8	OPDEF	SIXPNT	[6B8]
ARERR←7B8	OPDEF	ARERR	[7B8]
RECUUO ← 10B8	OPDEF	RECUUO	[10B8]
DECPNT←11B8	OPDEF	DECPNT	[11B8]
OCTPNT←12B8	OPDEF	OCTPNT	[12B8]
ERRSPL←13B8	OPDEF	ERRSPL	[13B8]
TENX <
PUUO←15B8	OPDEF	PUUO	[15B8]
		OPDEF	TTCALL	[PUUO]
>;TENX
NOTENX <
PUUO←<TTYUUO>	OPDEF	PUUO	[TTYUUO]
		OPDEF	TTCALL	[TTYUUO]
>;NOTENX
JFOV←<JFCL 1,0>	OPDEF	JFOV	[JFCL 1,0]
		OPDEF	TRZ	[ANDCMI]
		OPDEF	TRC	[XORI]
		OPDEF	TRO	[IORI]
STANFO <
DPYOUT←703B8	OPDEF	DPYOUT	[703B8]
DPYCLR←701B8	OPDEF	DPYCLR	[701B8]
UINBF←704B8	OPDEF 	UINBF	[704B8]
?SEGSIZUUO 	← 400022	;GET SIZE OF SECOND SEGMENT.
?CORE2UUO	← 400015	;GET SOME MORE SECOND SEGMENT.
?GLBAR		←← 1000		;CURRENT LENGTH OF GLOBAL MODEL AREA.
>;STANFO
SUBTTL	SAIL/GOGOL USER TABLE DESCRIPTION
DEFINE XX (SYMBOL,SIZE,BACKUP) <
	?SYMBOL←←LOCAT
IFN HEDSYM,<
	ENTRY	SYMBOL			;FOR HEAD.REL SYMBOL FILE
>;N HEDSYM
	LOCAT←←LOCAT+1
	IFDIF<SIZE><>< LOCAT←←LOCAT+SIZE-1>
	IFDIF<BACKUP><>< LOCAT←←LOCAT-BACKUP>
>
LOCAT←←0		;MAKES SYMBOLS ABSOLUTE
 XX CLER,,1
 XX UUO1	;TRADITIONAL LOC FOR GOGOL RETRN ADRS FOR ERROR MSGS.
 XX STRLNK
 XX SPLNK	;LINK END FOR SPACE ALLOCATION.
 XX SETLNK	;LINK END FOR SETS.
 XX SGROUT	;LINK UP STRING DSCRPTR GENERATOR ROUTINES HERE
 XX KNTLNK	;PROFILE COUNTER LINK END
 XX ST		;BOTTOM OF STRING SPACE
 XX STTOP	;TOP OF SAME
 XX STLIST	;HEAD OF LIST OF STRING SPACES
 XX TOPBYTE	;NEXT FREE BYTE
 XX REMCHR	;-REMAINING FREE CHARS
 XX SGLIGN	;ON IF MUST BE ALIGNED TO FW BDRY (COMPILER ONLY).
 XX CHANS,20
 XX BKTPRV		;0→UNPRIVILEGED, ≠0→PRIVILEGED
 XX BKTPTR,4,,		;POINTERS TO CORGET BLOCKS OF 18 BREAKTABLES EACH
	DSPTBL←←0		;BREAK CHAR DISPOSITION TABLE
	LINTBL←←=19+DSPTBL	;LINE NUMBE    "	"
	BRKTBL←←=19+LINTBL	;BREAK CHAR TABLE
	BKJFFO←←=128+BRKTBL	;RESERVATION WORD
	BRKCVT←←1+BKJFFO	;UPPER CASE CONVERSION
	BRKOMT←←1+BRKCVT	;OMIT SPEED UP
	BRKDUM←←1+BRKOMT	;%DQ% used to hold "Z" bit flag
XX  TTYCVT		; DITTO FOR TTY INPUT
XX  FSTATS		; FOR GETSTS
 XX PDL		;IOWD SIZE,BASE  FOR SYSTEM PDL
 XX SPDL	;XWD SIZE,BASE FOR STRING PDL
STANFO <
XX  ZAPBEG,,1	;BEGINNING OF SECOND SEGMENT COPY OF STUFF.
>;STANFO
CMU <
XX  ZAPBEG,,1	;JUST LIKE SU-AI
>; CMU
STANFO <
 XX CURMES		;CURRENT MESSAGE.
>;STANFO
 XX MAXITM		;CURRENT TOP ITEM NUMBER.
 XX OLDITM		;LINKED LIST OF OLD ITEMS (DUMP HEAP).
 XX INFOTAB		;POINTER TO "GOOD POINTER" BLOCK OF CORE.
 XX DATAB		;POINTER TO DATUM AREA.
 XX HASTAB		;POINTER TO THE LEAP HASH TABLE.
 XX FP1			;FREE STORAGE -- 1 WORD.
 XX FP2			;FREE STORAGE -- 2 WORDS.
 XX HASMSK		;THE MASK FOR HASHING INTO OUR HASH SPACE.
URHASH <
XX RMASK1		;NEW MASK FOR MODIFIED LEAP ROUTINES
XX RMASK2
XX RMASK3
XX RMASK4		;END OF NEW MASKS (3/15/76 --
>;URHASH
URLEAP <
XX BRACKL		;POINTER TO LIST OF BRACKETED TRIPLE BLOCKS
>;URLEAP
 XX HASHP		;FOR PNAMES. XWD NEXT FREE ARRAY ENTRY,ARRAY BASE.
 XX MKBP		;MAKE BREAK-POINT
 XX ERBP		;ERASE BREAK-POINT
 XX PUBP		;PUT BREAK-POINT (NOT IMPLEMENTED)
 XX REBP		;REMOVE BREAK-POINT.(NOT IMPLEMENTED)
 XX ITMTOP		;MAXIMUM PERMISSIBLE ITEM NUMBER.
 XX LEABOT		; PTR TO SEARCH CONTROL BLOCK FOR DERIVED SETS ERASE. 
 XX FRLOC		; PTR TO CURRENT ACTIVE FOREACH CONTROL BLOCK POINTER
 XX SCBCHN		; PTR TO CHAIN OF ABANDONED SCB'S
 XX FREITM	;NUMBER OF FREE ITEMS REMAINING
 XX ARYDIR	;FOR TELLING FOUR ARRAY ROUTINES WHICH END IS UP.
 XX ARYLS	;A LINKED LIST (LUCKILY) OF STRING ARRAYS IN LEAP, AND SO FORTH.
XX BLKTAB,3,3	;BASE OF BLOCK CONTROL TABLE
   XX LOWC	;LOW LIMIT OF ALLOCATABLE "BLOCK" CORE
   XX TOP	;UPPER LIMIT OF SAME
   XX FRELST	;POINTER TO BLOCK FREE STORAGE LIST
 XX XPAND	;PERMISSION TO EXPAND IN CORREL IF 0
 XX ATTOP	;REQUEST TO ALLOCATE OFF TOP OF CORE IF NON-0
 XX NOSHRK	;IF ON, CORREL NOT GIVEN PERMISSION TO SHRINK CORE
STANFO <
 XX USCOR2	;IF ON, CORGET WILL USE CORE2 ROUTINES.
>;STANFO
 XX BUFACS,10,,	;FOR BUFFER ALLOCATOR
STANFO <
XX ZAPEND,,1	;END OF SECOND SEGMENT AREA.
>;STANFO
CMU <
XX USCOR2		;THE COPYCATS
XX ZAPEND,,1		;ditto ZAPBEG
>;CMU
 XX STBUCK,1,1	;USED IN STRING GC TO KEEP TRACK OF BLOCKS
   XX OFFSET		;Distance to move a string space, see STRNGC
 XX STINCR		;String space increment size, see STRNGC
 XX STREQD		;String space threshold size, see STRNGC
 XX SGCCNT		;NUMBER OF TIMES STRNGC HAS BEEN CALLED
 XX SGCTIME		;Time of last GC if non-zero, else not enabled
 XX SGCTOTAL		;Total GC time while enabled (set SGCTIME -1 to enable)
 XX SGCNUM		;Number of strings collected last GC
 XX SGCWASTE		;Number of wasted words after last GC
 XX SRELOC
 XX CODAC		;SAVE AC 1 OVER CALLS ON "CODE" RUNTIME ROUTINE
 XX WDTH		;GLOBAL WIDTH FOR STRING CONVERSION ROUTNES
 XX DIGS		; "" FOR # OF DECIMAL DIGITS
 XX CDBLOC	;IF CHNL IS A CH #, @CDBLOC(USER) GETS ITS CDB ADDR
 XX FNAME	;ENTER-LOOKUP TABLE
 XX EXT
 XX WD3
 XX PRPN
 XX LONGWD	;LONG FORM LOOKUPS AND ENTERS POKE THIS
 XX LONG2	; AND THIS -- FILEINFO ROUTINE GIVES TO USER
 XX PROJ		;USED BY FILNAM ROUTINE
TYMSHR<
XX FUSER
XX FUSER1	;TYMSHARE USER NAMES
>
 XX RACS,13,,	;RE-ENTRANT ROUTINES SAVE HERE
 XX SGACS,14,,	;AVAILABLE ANY TIME IF YOU ARE NOT
 XX STACS,14,,	;YET ANOTHER AC SAVE AREA
 XX PGNNFL
?NPRIS←←20	;NUMBER OF PRIORITIES
 XX PRILIS,NPRIS,, 	;PRIORITY LIST HEADERS
 XX GGDAD		;THE BASE FOR THE MAIN PROCESS (IF HAVE ONE)
 XX TIMER		;COUNTED DOWN FOR CLOCK INTERRUPTS
 XX SCHDRQ		;SET ≠0 FOR A SCHEDULER REQUEST
 XX STKURT		;PLACE FOR STACKUNWINDER RETN ADRS
 XX INTQWP		;INTERRUPT NOTICE BUFFER WRITE PTR
 XX INTQRP		;READ PTR
 XX INTQWT		;TOP OF BUFFER 
 XX INTQWB		;BOTTOM OF BUFFER
 XX INTPRC		;INTERRUPT PROCESS BASE
 XX DISPAT		;DISPATCH TABLE FOR INTERRUPT LEVEL MODULE
 XX DFRINF		; AOBJN PTR TABLE FOR DEFERRED INTERRUPTS
NOTENX<
 XX IPDP		;INTERRUPT PDP
>;NOTENX
TENX<
 XX IPDP1
 XX IPDP2
 XX IPDP3
 XX ISPDP1
 XX ISPDP2
 XX ISPDP3
 XX TIMFRK		;TABLE OF FORK HANDLES FOR INTERRUPT SYSTEM, PROCESSES
>;TENX
 XX IJBCNI		;JOBCNI FROM A DEFERRED INTERRUPT
 XX IJBTPC		;JOBTPC FROM DEFERRED INTERRUPT
 XX IRUNNR		;RUNNER AT TIME OF DEFERRED INTERRUPT
NOTENX<
 XX ISPDP		;STRING PDP FOR INTERRUPT LEVEL
>;NOTENX
 XX $FSLIS		;LIST OF FREE STORAGE ALLOCATORS
 XX PRNINF		;$PRINT DEFAULTS
 XX BAILOC		;IF NONZERO, ADDRESS OF BAIL INTERCEPT ROUTINE
 XX JFRCEL		; USED TO BE XX <NOTHING>
 XX RSGCLK		;THE TWO WORD BLOCK REQUIRED BY SGINS
 XX RSGCL2		; AND A SECOND WORD
 XX STBLST		;HEAD OF CHAIN OF STRING DESCR ARRAYS FOR RECORDS
 XX RGCOFF		;SET THIS TO TURN OFF AUTO GC
 XX TGRADJ		;PUT PUSHJ ADR HERE TO ADJUST OWN TRIGGER LEVELS
 XX RGCRHO		;-1.0+1/"%FILL" LEVEL DESIRED FOR RECORD SPACES
 XX SPARUT,1,,		;SPARE USER TABLE ENTRIES
 XX PRTINF		;PRINT OUTPUT INFORMATION  XWD BITS,CHAN
 XX $$PROU		;PRINT OUTPUT TRAP FOR ALL STRINGS
 XX $$FINT		;USER FORMATTING FUNCTION FOR INTEGERS
 XX $$FREL		; "         "       "      "  REALS
 XX $$FITM		; "         "       "      "  ITEMS
 XX $$FSET		; "         "	    "	   "  SETS
 XX $$FLST		; "	    "	    "	   "  LISTS
 XX $$FSTR		; "	    "       "      "  STRINGS
 XX $$FREC		; "         "       "      "  RECORDS
SFDS<
 XX PATHBL,4+SFDLVL,,		;PATH BLOCK
> ;SFDS
 XX ENDREN	; END OF USER DATA TABLE
SUBTTL	Global AC Definitions, Indices, Bits
AC2DATA (GLOBAL AC ASSIGNMENTS)
?P	←17
?SP	←16
?USER	←15
?TEMP	←14
?LPSA	←13
?RF	←←12			;THE ALMIGHTY F REGISTER
?TAC1	←←TEMP
?TAC2	←←LPSA
BITDATA (BITS FOR %ALLOC SPACE REQUEST BLOCK ENTRIES)
?STDSPC ←←400000	;"INDIRECT" SPECIFICATION OF STANDARD AREA
?WNTADR ←←200000	;ADDRESS OF AREA TO BE STORED AS SPECIFIED
?WNTEND ←←100000	;ADDRESS OF NEXT AREA TO BE STORED AS SPECIFIED
?WNTPDP ←← 40000	;PDP TO AREA TO BE STORED " "
?WNTPDL ←← WNTPDP	;WNTPDP, WNTPDL -- WHAT'S THE DIFFERENCE?
?USRTB  ←← 20000	;RESULT ADDRESSES ARE IN THE USER TABLE
?MINSZ  ←← 10000	;THIS SIZE TO BE USED ONLY IF NO OTHERS GIVEN
BITDATA (INDICES OF STANDARDLY ALLOCATED AREAS (SEE %ALLOC))
?SYSPD	←← 1		;SYSTEM!PDL
?SYSSPD	←← 2		;STRING!PDL
?STRSP	←← 3		;STRING!SPACE
BITDATA (INDICES INTO THE FIXED PORTION OF EACH %ALLOC SPACE REQ. BLOCK)
?$ITNO	←←1		;MAX ITEM NUMBER DECLARED THIS COMPILATION
?$NWITM ←←2		;XWD REQUIRED BUCKETS,REQUIRE  NEW!ITEMS 
?$GITNO	←←3		;MAX (MIN?) GLOBAL ITEM NUMBER DECLARED
?$MSLNK	←←4		;POINTER TO MESSAGE PROCEDURE LIST PUT HERE
?$PNMNO	←←5		;REQUIRE n PNAMES PUTS n HERE
?$VRNO	←←6		;VERSION NUMBER
?$SGNM	←←7		;REQUIRED GLOBAL SEGMENT NAME (USUALLY EMPTY)
?$SGD	←←10		;REQUIRED GLOBAL SEGMENT FILE DEVICE
?$SGF	←←11		;" FILE NAME
?$SGPP	←←12		;" PPN
?$TINIT ←←13		; POINTER TO INITIAL ITEM TYPES
?$PINIT ←←14		; POINTER TO INITIAL PRINTNAMES
?$CMVER ←← 15		;com version
?$OBPDA ←← 16		; pointer to outer block pda
?$SPREQ ←← 20		; leaves a spare
ENDDATA
BITDATA (LINK NAMES)
?%STLNK ←← 1
?%SPLNK ←← 2
?%SETLK ←← 3
?%SGROT ←← 4
?%KTLNK ←← 5
?%PDLNK ←← 6
?%INLNK ←← 7
?%RBLNK ←← 10
BAIL<
?%BALNK ←← 11
>;BAIL
?%RCLNK ←← 12		;RECORD CLASS LINK
BITDATA (PROCEDURE DESCRIPTOR INDICES)
	DEFINE PDX(I),
		<?I ←← PD.XXX
		PD.XXX←←PD.XXX+1
>
PD.XXX	←← 0
	PDX	PD.	;0
	PDX	PD.ID1	;1
	PDX	PD.ID2	;2
	PDX	PD.PDB	;3
	PDX	PD.NPW	;4
	PDX	PD.DSW	;5
	PDX	PD.LLW	;6
	PDX	PD.DLW	;7
	PDX	PD.PDA	;10
	PDX	PD.PPD	;11
	PDX	PD.PCW	;12
	PDX	PD.BDI	;13
?PD.XXX←←PD.XXX
BITDATA (TYPE CODES WITHIN RH OF INFOTAB ENTRY)
	NOTYPE ←← 1	;NO TYPE AT ALL
        BRKITM ←← 2	;BRACKETED TRIPLE
	STTYPE ←← 3	;STRING ITEM
	FLTYPE ←← 4	;REAL ITEM
	INTYPE ←← 5	;INTEGER ITEM
	LSTYPE ←← 7	;LIST ITEM (TYPE SHOULD ALWAYS BE 1 MORE THN SETYPE
	SETYPE ←← 6	;SET ITEM
	PITTYP ←← 10	;PROCEDURE ITEM
	PRCTYP ←← 11	;PROCESS ITEM
	EVTTYP ←← 12	;EVENT TYPE ITEM
	CTXTYP ←← 13	;CONTEXT ITEM
	RFITYP ←← 14	;REFERENCE ITEM
	RECTYP ←← 15	;RECORD
	LBLTYP ←← 16	;LABEL
	RCLTYP ←← 17	;RECORD CLASS
	ITVTYP ←← 20	;ITEMVAR
	MXSTYP ←← ITVTYP; LAST SIMPLE TYPE
	ARRTYP ←← 24	;ARRAYS ARE THIS PLUS SIMPLE TYPE CODE
	INVTYP ←← MXSTYP+ARRTYP+1; NON-VALID TYPE CODE
BITDATA (RECORD CLASS TYPE BITS)
	NODELC ←← 1	;DO NOT DELETE RECORDS OF THIS CLASS (VIA GC)
	CMPLDC ←← 2	;THIS RECORD CLASS IS COMPILED-IN
	HASRPS ←← 4	;HAS RPTR / RPTR ARRAY
	HASSTR ←← 10	;HAS STRING / STRING ARRAY SUBFIELDS
BITDATA( PROC DESC STUFF)
?BLKCOD←←17				;BLOCK BOUNDARY CODE
?EOPCOD←←0				;END OF PROC LVI CODE
?AACOD←←1					;ARITH ARRAY
?SACOD←←2					;STRING ARRAY
?SETCOD←←3				;SET
?LACOD←←4					;LIST OR SET ARRAY
?FRCCOD←←5				;FOREACH STATEMENT
?KLCOD←←6				;KILL LIST
?CTXCOD ←← 7				;CONTEXT
?CLNCOD ←← 10				;CLEANUP PROC
?RPCOD ←← 11				;RECORD PTR
?RPACOD ←← 12				;RECORD PTR ARRAY
ENDDATA
BITDATA (USE OF THE RESERVED ITEMS)
	ITMANY ←← 0	;ITEM FOR ANY
	MAINPI ←← 1	;ITEM NUMBER OF THE MAIN PROCESS ITEM
	UNBND  ←← 2	;UNBOUND (?ITEMVARS ETC)
	EVTYPI ←← 3	;THE ITEM EVENT!TYPE
	NIC    ←← UNBND	;ITEM GET BACK FROM EMPTY NOTICE QUEUE
	?MAXLOC ←← =10	;MAXIMUM NUMBER OF LOCAL ITEMVARS IN FOREACH
	?QBIND ←← 200	;A ? ITMVR (NOT A MP PARM)
	?FBIND ←← 100	;A BIND ITMVR(HERE BECAUSE OF STATS)
BITDATA (THE NAMED BITS FOR REF ITEMS)
	?TMPB ←← 400000 ; SIGN BIT MEANS A TEMP REF ITEM
	?REFB ←← 200000	;USUALLY SET
	?QUESB ←← 100000;FOR ? ITEMVARS
	?BINDB ←← 40000	;FOR BIND ITEMVAR
	?PROCB ←← 20000	;NOT NOW REALLY USED
	?ITEMB ←← 10000	; AN ITEM (ITEMVAR)
	?ARY2B ←← 4000	;FOR * ARRAY ITEMVAR ARRAY REFERENCES
	?MSK6BT ←← 3740 ; BITS FOR SIX BIT TYPE
	?MSKUNT ←← 3700	;BIT MASK FOR UNTYPED 
ENDDATA
 SYSPHS←←2			;TWO SYSTEM PHASES
 USRPHS←←3			;THREE USER PHASES (FOR NOW)
IFN HEDSYM, <		;MAKE AN HONEST ASSEMBLY OUT OF IT
	TITLE	HEAD
	END
>;IFN HEDSYM
DEFINE .VERSION <102200000016>
SUBTTL	Command File Descriptions
	LSTON	(GOGOL)
SUBTTL	Conditional Assembly Switches, Macros
STSW(UPPER,0)		;NOT UPPER OR LOWER IF NEITHER SET
STSW(LOWER,0)
STSW(GLOBSW,0)		;ONLY GLOBAL IF SOMEBODY ELSE SAID SO
STSW(SEGS,0)
STSW(RENSW,0)		;RE-ENTRANT LIBRARY (HISEG) IF ON
STSW(LEAPSW,1)		;ASSUME LEAP
EXPO <
STSW(APRISW,1)		;THE APR INTERRUPT PACKAGE IS TO BE USED
>;EXPO
NOEXPO <
STSW(APRISW,0)		;USUALLY USE THE MOORER PACKAGE
>;NOEXPO
DEFINE COMPIL ' (NAM,ENT,EXT,DSCRP,INT,HINHB,DUMMY) <
IFIDN <DUMMY>,<> <
SUBTTL SAI'NAM -- DSCRP
IFE ALWAYS,<
	IFDIF <><ENT>,<ENTRY ENT>
	TITLE	SAI'NAM
REN <
	IFIDN <><HINHB>,<HISEG		;LOAD TO UPPER IF POSSIBLE>
>;REN
	IFDIF <><EXT>,<EXTERN EXT>
>;IFE ALWAYS
NOLOW <
	IFDIF <><INT>,<INTERN INT>
IFN ALWAYS,<
IFDIF <NAM><LOR>,<
IFDIF <><ENT>,<INTERNAL ENT>
>>
>;NOLOW
>;IFIDN <DUMMY>
>
DEFINE COMPXX ' (NAM,ENT,EXT,DSCRP,INT,HINHB) 
	<COMPIL(<NAM>,<ENT>,<EXT>,<DSCRP>,<INT>,<HINHB>)>
DEFINE ENDCOM (NAM) <
IFE ALWAYS,<
	END
>;IFE ALWAYS
>
IFNDEF ALWAYS,<?ALWAYS←←1>
IFN ALWAYS,<DEFINE ENTINT (X) <INTERNAL X>>
IFE ALWAYS,<DEFINE ENTINT (X) <ENTRY X>>
SUBTTL	Titles, Versions
IFN ALWAYS,<
LOW <
	TITLE LOWER
>;LOW
NOUP <
NOLOW <
	TITLE RUNTIM -- SAIL RUNTIME ROUTINES
>;NOLOW
JOBVER←←137
	LOC	JOBVER
	.VERSION&777777000000	;CURRENT VERSION NUMBER (LH ONLY)
	RELOC
>;NOUP
>;ALWAYS NEQ 0
SUBTTL	AC Definitions
?FF←←0
?A←1						;TEMPS FOR ALLES
?B←2						; (SOMETIMES SAVED)
?C←3
?D←4
		?E←5		?X←5		;MORE TEMPS
		?Q1←6		?Y←6
		?Q2←7		?Z←7
		?Q3←10		?CHNL←10	;CHNL # FOR IOSER
		?T←11		?CDB←11		;CHANNEL DATA BLOCK PTR
		?T1←12				;TRY TO KEEP 12(RF) VALID.
?LPSA←13					;TEMP, PARAM AC
?TEMP←14					;TEMP ONLY
?USER←15					;PTR USER TABLE FOR RNTRNT ROUTS
?SP←16						;STRING STACK
?P←17						;SYSTEM STACK
SUBTTL	CDB, SIMIO Indices For IOSER, OTHER INDICES
	?IOSTATUS ←← 0		;RETURN STATUS
	?IOIN     ←← 1		;BUFFERED INPUT
	?IODIN    ←← 2		;DUMP INPUT
     	?IOOUT    ←← 3		;BUFMODE OUT.
	?IODOUT   ←← 4		;DUMP OUTPUT
	?IOCLOSE  ←← 5		;CLOSE FILE
	?IORELEASE←← 6		;RELEASE FILE
	?IOINBUF  ←← 7		;INBUF
	?IOOUTBUF ←←10		;OUTBUF
	?IOSETI   ←←11		;USETI
	?IOSETO   ←←12		;USETO
	?SETIOSTS ←←13		;SET IO STATUS
	?IOOPEN ←←14		;OPEN CHANNEL
	?IOLOOKUP ←←15		;LOOKUP FILE
	?IOENTER  ←←16		;ENTER FILE
	?IORENAME ←←17		;RENAME FILE
TYMSHR <;CHANIO INDICES
	?CIOIN←←14
	?CIOOUT←←15
	?CIOCLS←←1
	?CIORLS←←0
	?CIOIBF←←22
	?CIOOBF←←23
	?CIOUSI←←6
	?CIOUSO←←7
	?CIOSTS←←16
	?CIOOPN←←13
	?CIOLUK←←4
	?CIOENT←←5
	?CIOREN←←11
	?CIOGST←←17
>;TYMSHR
	DMODE	←← 0		;DATA MODE	
	DNAME	←← 1		;DEVICE	
	BFHED	←← 2		;HEADER POINTERS	
	OBPNT	←← 3		;OUTPUT BUF. PTR	
	OBP	←← 4		;OUTPUT BYTE PTR	
	OCOWNT	←← 5		;OUTPUT BYTE CNT
	ONAME	←← 6		;OUTPUT FILE NAM
	OBUF	←← 7	 	;OUTPUT BUFFER LOC.
	IBPNT	←←10		;SAME FOR INPUT
	IBP	←←11	
	ICOWNT	←←12
	INAME	←←13	
	IBUF	←←14	
	ICOUNT	←←15		;INPUT DATA COUNT LIMIT ADDRESS
	BRCHAR	←←16		;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
	TTYDEV  ←←16		;LH -1 IF DEVICE IS A TTY -- USED BY OUT
	ENDFL	←←17		;INPUT END OF FILE FLAG ADDR
	ERRTST	←←20		;USER ERROR BITS SPECIFICATION WORD
	LINNUM  ←←21		;ADDR OF LINE NUMBER WORD (SETPL FUNCTION)
	PAGNUM  ←←22		;ADDR OF PAGE NUMBER WORD (SETPL FUNCTION)
	SOSNUM  ←←23		;ADDR OF SOS NUMBER WORD  (SETPL FUNCTION)
?IOTLEN	←←SOSNUM+1	;LENGTH OF TABLE ENTRY
?LUPDL←30			;LENGTH OF UUO PDL
?MINPDS←←=64			;SMALLEST ALLOWABLE SYSTEM PDL SIZE
?DEFPDS←←=192			;DEFAULT PDL SIZE
?.ERSWC ←← 20			;SIZE OF BUILT IN .ERSTR BUFFER
GLOB < 
?GBRK ←← 6000			;MIN GLOBAL ITEM NUMBER
>;GLOB
?.HDRSIZ←←4			;Header allocated in each string space
?.NEXT←←-1			;Next string space
?.LIST←←-2			;Used to link descriptors during GC
?.SIZE←←-3			;Size of this space
?.STTOP←←-4;<			;=> 1 past last word this space (redundant)
SUBTTL	Base (Low Segment) Data Descriptions -- Macros, Compil spec
NOUP <
DEFINE SGLK (ROUT,NAM,INT) <
 XX	(NAM,ROUT,INT)	;NAME OF STRING DSCRPTR GENERATING ROUTINE
 XX	(,0,)		;PLACE TO PUT A LINK
 LINK	%SGROT,.-1	;WHEREWITHAL TO GENERATE SAID LINK
>
>;NOUP
UP <
DEFINE SGLK (ROUT,NAM) <
 XX	(NAM,ROUT,)
 XX	(,0,)
>
>;UP
DEFINE XX  (A,B,C,D) <
	IFDIF <A><>,<? A :> B
	IFDIF <C><>,< C A >
>
UP <
III←←140
	DEFINE XX (A,B,C,D) <
	IFDIF <A><>,<? A ← III >
	III ←← III + 1
	IFDIF <D><>,<III←III+D-1>
>
>;UP
END
END